package SVN::TeamTools::DB::oracleDDL;

use warnings;
use strict;
use Carp;
use Error qw(:try);
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(getDDL getPath);

use SVN::TeamTools::Store::Config;

use DBI;
use DBD::Oracle qw(:ora_types);
use Data::Dumper;

my $conf;
my $logger;
BEGIN { $conf = SVN::TeamTools::Store::Config->new(); $logger = $conf->{logger}; }

use Getopt::Long;

### ################################################################################################################################
### Some constants
my $types = {
	'CONTEXT'		=> {'metatype' => 'CONTEXT',		'ext' => 'sql',	'filter' => '',	'path' => 'context'},
#	'DATABASE LINK'		=> {'metatype' => 'DB_LINK',		'ext' => 'sql',	'filter' => '',	'path' => 'dblink'},
	'DIRECTORY'		=> {'metatype' => 'DIRECTORY',		'ext' => 'sql',	'filter' => '',	'path' => 'directory'},
	'FUNCTION'		=> {'metatype' => 'FUNCTION',		'ext' => 'sql',	'filter' => '',	'path' => 'function'},
	'INDEXTYPE'		=> {'metatype' => 'INDEXTYPE',		'ext' => 'sql',	'filter' => '',	'path' => 'indextype'},
	'JAVA SOURCE'		=> {'metatype' => 'JAVA_SOURCE',	'ext' => 'sql',	'filter' => '',	'path' => 'javasrc'},
#	'JOB'			=> {'metatype' => 'JOB',		'ext' => 'sql',	'filter' => '',	'path' => 'job'},
	'LIBRARY'		=> {'metatype' => 'LIBRARY',		'ext' => 'sql',	'filter' => '',	'path' => 'library'},
	'MATERIALIZED VIEW'	=> {'metatype' => 'MATERIALIZED_VIEW',	'ext' => 'sql',	'filter' => '',	'path' => 'mview'},
	'PACKAGE'		=> {'metatype' => 'PACKAGE_SPEC',	'ext' => 'pks',	'filter' => '',	'path' => 'package/spec'},
	'PACKAGE BODY'		=> {'metatype' => 'PACKAGE_BODY',	'ext' => 'pkb',	'filter' => '',	'path' => 'package/body'},
	'PROCEDURE'		=> {'metatype' => 'PROCEDURE',		'ext' => 'sql',	'filter' => '',	'path' => 'procedure'},
	'SEQUENCE'		=> {'metatype' => 'SEQUENCE',		'ext' => 'sql',	'filter' => '',	'path' => 'sequence'},
	'SYNONYM'		=> {'metatype' => 'SYNONYM',		'ext' => 'sql',	'filter' => '',	'path' => 'synonym'},
	'TABLE'			=> {'metatype' => 'TABLE',		'ext' => 'sql',	'filter' => '',	'path' => 'table'},
	'TRIGGER'		=> {'metatype' => 'TRIGGER',		'ext' => 'sql',	'filter' => '',	'path' => 'trigger'},
	'TYPE'			=> {'metatype' => 'TYPE_SPEC',		'ext' => 'sql',	'filter' => '',	'path' => 'type'},
#	'TYPE BODY'		=> {'metatype' => 'TYPE_BODY',		'ext' => 'sql',	'filter' => '',	'path' => 'typebody'},
	'VIEW'			=> {'metatype' => 'VIEW',		'ext' => 'sql',	'filter' => '',	'path' => 'view'},
#	'XML SCHEMA'		=> {'metatype' => 'XMLSCHEMA',		'ext' => 'sql',	'filter' => '',	'path' => 'xmlschema'},
};


### ################################################################################################################################
### Function to get rid of newlines at top and bottom

sub arrTrunc {
	my @array	= @_;

	while ( $array[scalar(@array)-1] =~ /^\s*$/ ) {
		pop (@array);
	}
	while ( $array[0] =~ /^\s*$/ ) {
		shift (@array);
	}
	return @array;
}

sub getDDL {
	my %args	= @_; # hostname, port, dbname, schema, passwd, obj_type, obj_owner, obj_name

	my %result;
	my $dsn="DBI:Oracle:host=$args{hostname};sid=$args{dbname};port=$args{port}";
	$result{msg}="DSN: $dsn\n";
	$result{status}=1;

	my $dbh;
	eval {$dbh = DBI->connect($dsn,
			$args{schema},$args{passwd},
			{ RaiseError => 1, AutoCommit => 0, ora_check_sql => 1, LongReadLen => 100000000, LongTruncOk => 0 }
		) or die "Can't connect: $DBI::errstr\nCheck the apache logs\n" 
	};
	if ( $@ ) {
		$result{msg} .= "\nFailed to connect to database:\n" . $@; $result{status}=0; return \%result;
	} else {
		$result{msg} .= "\nSuccesfully connected\n";
	}

	my $stmnt;

	my $sth_obj;
	eval {
		$stmnt = "SELECT object_id, created, last_ddl_time, status FROM dba_objects WHERE owner = :owner AND object_name = :object_name";
		$sth_obj = $dbh->prepare ($stmnt);
		$sth_obj->bind_param (":object_name", $args{obj_name});
		$sth_obj->bind_param (":owner", $args{obj_owner});
		$sth_obj->execute();
	};
	if ( $@ ) {
		$result{msg} .= "\nFailed to get object DDL:\n" . $@; $result{status}=0; return \%result;
	}

	my $sth_ddl;
	eval {
		$stmnt = "SELECT DBMS_METADATA.GET_DDL (:object_type, :object_name, :owner) ddl FROM dual";
		$sth_ddl = $dbh->prepare ($stmnt);
		$sth_ddl->bind_param (":object_type", $types->{$args{obj_type}}->{metatype});
		$sth_ddl->bind_param (":object_name", $args{obj_name});
		$sth_ddl->bind_param (":owner", $args{obj_owner});
		$sth_ddl->execute();
	};
	if ( $@ ) {
		$result{msg} .= "\nFailed to get object DDL:\n" . $@; $result{status}=0; return \%result;
	}

	my $sth_gra;
	eval {
		$stmnt = "SELECT grantee, privilege, grantable, hierarchy FROM dba_tab_privs WHERE owner=:owner AND table_name=:object_name";
		$sth_gra = $dbh->prepare ($stmnt);
		$sth_gra->bind_param (":object_name", $args{obj_name});
		$sth_gra->bind_param (":owner", $args{obj_owner});
		$sth_gra->execute();
	};
	if ( $@ ) {
		$result{msg} .= "\nFailed to get object grants:\n" . $@; $result{status}=0; return \%result;
	}

	my $sth_ind;
	if ( $args{obj_type} =~ /TABLE/ or $args{obj_type} =~ /MATERIALIZED VIEW/ ) {
		eval {
			$stmnt = "SELECT DBMS_METADATA.GET_DDL ('INDEX', index_name, owner) ddl FROM dba_indexes WHERE table_owner=:owner AND table_name=:object_name AND index_type IN ('FUNCTION-BASED DOMAIN','FUNCTION-BASED NORMAL','NORMAL') AND generated='N'";
			$sth_ind = $dbh->prepare ($stmnt);
			$sth_ind->bind_param (":object_name", $args{obj_name});
			$sth_ind->bind_param (":owner", $args{obj_owner});
			$sth_ind->execute();
		};
		if ( $@ ) {
			$result{msg} .= "\nFailed to get indexes:\n" . $@; $result{status}=0; return \%result;
		}
	}
	
	my ($object_id,$object_created,$object_last_ddl_time,$object_status) = $sth_obj->fetchrow_array();
	$sth_obj->finish();
	$result{stmnt} = "-- \n";
	$result{stmnt} .= "-- Owner:       $args{obj_owner}\n";
	$result{stmnt} .= "-- Object:      $args{obj_name}\n";
	$result{stmnt} .= "-- Type:        $args{obj_type}\n";
	$result{stmnt} .= "-- ID:          $object_id\n";
	$result{stmnt} .= "-- Created:     $object_created\n";
	$result{stmnt} .= "-- Last change: $object_last_ddl_time\n";
	$result{stmnt} .= "-- Status:      $object_status\n";
	$result{stmnt} .= "-- \n\n";


	my $ddl = $sth_ddl->fetchrow();
	$sth_ddl->finish();
	my @lines = arrTrunc(split (/\n/s, $ddl));
	if ( $args{obj_type} =~ /^TRIGGER/ ) {
		my $trigstat	= pop (@lines);
		@lines		= arrTrunc(@lines);
		push (@lines, "/");
		push (@lines, $trigstat);
		push (@lines, "/");
	} else {
		push (@lines,"/\n\n");
	}
	$result{stmnt} .= join("\n",@lines);

	if ( $args{obj_type} =~ /^TABLE$/ ) {

		### Indexes
		while ( my $ddl = $sth_ind->fetchrow() ) {
			my @lines = arrTrunc(split (/\n/s, $ddl));
			push (@lines,"/\n\n");
			$result{stmnt} .= join("\n", @lines);
		}
	}

	### Grants
	while ( my ($grantee, $privilege, $grantable, $hierarchy) = $sth_gra->fetchrow_array() ) {
		$result{stmnt} .= "GRANT $privilege ";
		if ( $args{obj_type} =~ /^DIRECTORY$/ ) {
			$result{stmnt} .= "ON DIRECTORY $args{obj_name} TO ";
		} else {
			$result{stmnt} .= "ON $args{obj_owner}.$args{obj_name} TO ";
		}

		$result{stmnt} .= "$grantee ";

		if ( $hierarchy =~ /Y/ ) {
			$result{stmnt} .= "WITH HIERARCHY OPTION ";
		}
		if ( $grantable =~ /Y/ ) {
			$result{stmnt} .= "WITH GRANT OPTION ";
		}
	}
	$dbh->disconnect();
	return \%result;
}

sub getPath {
	my %args	= @_; # obj_type, obj_owner, obj_name

	my %result;
	$result{path} = "oracle/ddl/$args{obj_owner}/" . $types->{$args{obj_type}}->{path} . "/$args{obj_name}." .$types->{$args{obj_type}}->{ext};
	return \%result;
}
1;
